Emacs News

blog/2024/02/2024-02-05-emacs-news

(setq org-ascii-links-to-notes nil)

(defvar my-reddit-upvoted-json "https://www.reddit.com/user/emacsnews/upvoted.json" "JSON for upvoted posts.")
(require 'helm-utils)
(defun my-reddit-list-upvoted (date)
  (interactive (list (org-read-date)))
  (let ((threshold (org-read-date nil t (concat (substring date 0 (min (length date) 10)) " 0:00")))
        (url my-reddit-upvoted-json)
        results)
    (while url
      (with-temp-buffer
        (url-insert-file-contents url)
        (decode-coding-region (point-min) (point-max) 'utf-8)
        ;; (goto-char (point-min))
        ;; (re-search-forward "^$")
        (let* ((data (json-read))
               (items (assoc-default 'children (assoc-default 'data data)))
               (after (assoc-default 'after (assoc-default 'data data)))
               (result
                (mapconcat
                 (lambda (item)
                   (let* ((o (assoc-default 'data item))
                          (title (assoc-default 'title o))
                          (url (helm-html-decode-entities-string (assoc-default 'url o)))
                          (date (seconds-to-time (assoc-default 'created_utc o)))
                          (permalink (concat "https://www.reddit.com" (assoc-default 'permalink o)))
                          (num-comments (assoc-default 'num_comments o 'eq 0)))
                     (when (time-less-p threshold date)
                       (if (and (> num-comments 0) (not (string-match "reddit\\.com" url)))
                           (format "- %s (%s)\n"
                                   (org-link-make-string (url-unhex-string (if (string-match "^/" url)
                                                                               (concat "https://www.reddit.com" url)
                                                                             url))
                                                         title)
                                   (org-link-make-string (url-unhex-string (if (string-match "^/" permalink)
                                                                               (concat "https://www.reddit.com" permalink)
                                                                             permalink))
                                                         "Reddit"))
                         (format "- %s\n" (org-link-make-string (url-unhex-string (if (string-match "^/" url)
                                                                                      (concat "https://www.reddit.com" url)
                                                                                    url))
                                                                title))))))
                 items "")))

          (setq results (concat result "\n" results))
          (setq url
                (if (and after (> (length result) 0))
                    (concat my-reddit-upvoted-json "?after=" after)
                  nil)))))
    results))
;;  (my-reddit-list-upvoted "-mon")

(defvar my-emacs-news-playlist "https://www.youtube.com/playlist?list=PL4th0AZixyREOtvxDpdxC9oMuX7Ar7Sdt"
  "Public playlist with recent videos to include in Emacs News.")

(defun my-emacs-news-get-videos (playlist)
  (json-parse-string
       (concat "["
               (mapconcat
                'identity
                (split-string
                 (shell-command-to-string
                  (concat "yt-dlp -j --flat-playlist " (shell-quote-argument my-emacs-news-playlist) " 2> /dev/null"))
                 "\n" t)
                ",")
               "]")
       :object-type 'plist))

(defun my-save-new-items (file alist)
  (with-current-buffer (find-file-noselect file)
    (goto-char (point-min))
    (let* ((old-list (read (current-buffer)))
           (date (format-time-string "%Y-%m-%d"))
           (new-items (seq-difference (mapcar 'car alist)
                                      (mapcar 'car old-list)))
           (combined (append (mapcar (lambda (o) (append (list o date) (cdr (assoc o alist))))
                                     new-items)
                             old-list))
           (print-length nil))
      (erase-buffer)
      (insert "("
              (mapconcat 'prin1-to-string
                          combined
                          "\n")
              ")")
      (save-buffer)
      combined)))

(defun my-emacs-news-youtube-playlist (playlist &optional start-date end-date)
  (let* ((videos (my-emacs-news-get-videos playlist))
         (combined (my-save-new-items "video-list.el"
                                      (mapcar (lambda (o) (cons (plist-get o :id) o))
                                              videos))))
    (mapconcat
     (lambda (o)
       (if (numberp (plist-get o :duration))
           (format "- %s (%s)\n"
                   (org-link-make-string
                    (concat "https://www.youtube.com/watch?v=" (plist-get o :id))
                    (plist-get o :title))
                   (format-seconds "%.2h:%z%.2m:%.2s" (plist-get o :duration)))
         (format "- %s\n"
                   (org-link-make-string
                    (concat "https://www.youtube.com/watch?v=" (plist-get o :id))
                    (plist-get o :title))
                   )))
     (mapcar 'cddr
             (seq-filter (lambda (o) (and
                                      (or (null start-date) (not (string< (cadr o) start-date)))
                                      (or (null end-date) (string< (cadr o) end-date))))
                         combined))
     "")))


- Other:
  - Link A
  - Link B
- Emacs development:
  - Link A
  - Link B
- Emacs Lisp:
  - Link A
  - Link B

- Emacs Lisp:
  - Link A
  - Link B
- Emacs development:
  - Link A
  - Link B
- Other:
  - Link A
  - Link B

(defun my-org-sort-list-in-custom-order (order)
  "Sort the current Org list so that items are in the specified order.
  ORDER is a list of regexps."
  (org-sort-list
   nil ?f
   (lambda ()
     (let ((case-fold-search t)
           (item
            (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
              (org-sort-remove-invisible (buffer-substring (match-end 0) (point-at-eol))))))
       (or (cl-position item order :test (lambda (a b) (string-match b a))) (1+ (length order)))))
   '<))

(defvar my-emacs-news-sort-order
  '("Help wanted"
    "Security"
    ("Upcoming events" "meetup")
    ("Beginner" "beginner")
    ("Emacs configuration" "config")
    ("Emacs Lisp" "emacs lisp")
    ("Appearance" "theme\\|theming")
    ("Navigation" "search\\|tab bar")
    ("Hyperbole" "hyperbole")
    "TRAMP"
    ("Dired" "dired")
    "Writing"
    ("Org Mode" "org[ -]?mode\\|\\<org\\>\\|\\box-\\|\\bob-")
    ("Denote" "denote")
    ("Completion" "company\\|helm\\|selectrum\\|completion\\|vertico")
    ("Coding" "java\\|php\\|sql\\|cider\\|git\\|programming\\|scala\\|python")
    "Math"
    "Shells"
    ("Web" "eww")
    ("Chat" "mastodon\\|IRC\\|erc")
    ("Mail, news, and chat" "gnus\\|rmail\\|mail\\|notmuch\\|mu4e\\|elfeed")
    ("Evil mode" "evil")
    ("Spacemacs" "spacemacs")
    ("Doom Emacs" "doom")
    "Multimedia"
    ("EXWM" "exwm")
    "Fun"
    ("AI" "chatgpt\\|\\bai\\b\\|\\bllm\\b\\|openai")
    ("Community" "Weekly tips")
    "Other"
    "Emacs development"
    "Discussion"
    "Outside Emacs"
    "New packages"))
(defun my-emacs-news-sort-order-headings ()
  (mapcar (lambda (o) (if (stringp o) o (car o))) my-emacs-news-sort-order))
(defun my-emacs-news-sort-list ()
  (interactive)
  (goto-char (org-list-get-top-point (org-list-struct)))
  (my-org-sort-list-in-custom-order (my-emacs-news-sort-order-headings)))

(defun my-emacs-news-guess-category ()
  (save-excursion
    (when (re-search-forward org-any-link-re (line-end-position) t)
      (let* ((link (org-element-context))
             (description (buffer-substring-no-properties (org-element-property :contents-begin link)
                                                          (org-element-property :contents-end link))))
        (car (seq-find (lambda (o)
                         (and (listp o)
                              (string-match (cadr o) description)))
                       my-emacs-news-sort-order))))))
(defun my-emacs-news-auto-categorize ()
  (interactive)
  (while (and (looking-at "^- \\[\\[") (not (looking-at "^- New package")))
    (let ((category (my-emacs-news-guess-category)))
      (if category
          (my-org-move-current-item-to-category (concat category ":"))
        (forward-line 1)
        (goto-char (line-beginning-position))))))

(package-refresh-contents)
(my-update-package-list date)

(defvar my-package-list-file "~/sync/emacs-news/package-list.el")

(defun my-read-sexp-from-file (filename)
  (with-temp-buffer (insert-file-contents filename)
                    (goto-char (point-min)) (read (current-buffer))))

(defun my-update-package-list (&optional date)
  "Update the list of packages. Mark new packages with DATE."
  (interactive (list (format-time-string "%Y-%m-%d")))
  (setq date (or date (format-time-string "%Y-%m-%d")))
  (let* ((archives (my-get-current-packages date))
         (old-list (my-read-sexp-from-file my-package-list-file)))
    (mapc (lambda (o)
            (let* ((old-entry (assoc-default (car o) old-list))
                   (new-archives
                    (seq-difference
                     (mapcar 'cadr (cdr o))
                     (mapcar 'car (car (assoc-default (car o) old-list))))))
              (cond
               ((null (assoc (car o) old-list))
                ;; new package, add it to the list
                (setq old-list
                      (cons (list (car o)
                                  (mapcar
                                   (lambda (entry) (cons (cadr entry) date))
                                   (cdr o)))
                            old-list)))
               (new-archives
                ;; existing package added to a different repository
                (setf old-entry
                      (append
                       (mapcar (lambda (archive) (cons archive date))
                               new-archives)
                       old-entry
                       nil))))))
          archives)
    ;; Save to file, one package per line
    (with-temp-file my-package-list-file
      (insert "("
              (mapconcat #'prin1-to-string
                         old-list
                         "\n")
              ")"))
    old-list))

(vhdl-ts-mode (("melpa" . "2023-08-21")))

(defun my-get-current-packages (date)
  "Return a list of package symbols with the package archive and DATE.
Example entry: `(ack (ack \"gnu\" \"2023-09-03\"))`"
  (seq-group-by 'car
                (seq-mapcat (lambda (f)
                              (let ((base (file-name-base f)))
                                (mapcar
                                 (lambda (entry)
                                   (list (car entry) base date))
                                 (cdr
                                  (with-temp-buffer
                                    (insert-file-contents
                                     (expand-file-name "archive-contents" f))
                                    (goto-char (point-min))
                                    (read (current-buffer)))))))
                            (directory-files
                             (expand-file-name "archives" package-user-dir) t
                             directory-files-no-dot-files-regexp))))

(defun my-packages-between (from-date &optional to-date)
  (seq-filter
   (lambda (o)
     (and
      (or (not from-date) (not (string< (cdar (cadr o)) from-date)))
      (or (not to-date) (string< (cdar (cadr o)) to-date))))
   (my-read-sexp-from-file my-package-list-file)))

(defun my-list-new-packages (&optional date)
  (interactive)
  (let ((packages
         (my-describe-packages
          (seq-filter
           (lambda (o)
             (seq-remove (lambda (archive) (string< (cdr archive) date))
                         (cadr o)))
           (my-read-sexp-from-file my-package-list-file)))))
    (if (called-interactively-p 'any)
        (insert packages)
      packages)))

(defun my-describe-packages (list)
  "Return an Org list of package descriptions for LIST."
  (mapconcat
   (lambda (entry)
     (let* ((symbol (car entry))
            (package-desc (assoc symbol package-archive-contents)))
       (if package-desc
           (format "  - %s: %s (%s)"
                   (org-link-make-string (concat "package:" (symbol-name symbol))
                                         (symbol-name symbol))
                   (package-desc-summary (cadr package-desc))
                   (mapconcat
                    (lambda (archive)
                      (pcase (car archive)
                        ("gnu" "GNU ELPA")
                        ("nongnu" "NonGNU ELPA")
                        ("melpa" "MELPA")))
                    (cadr entry)
                    ", "))
         "")))
   list
   "\n"))

  (defun my-org-package-open (package-name)
    (interactive "MPackage name: ")
    (describe-package (intern package-name)))

(defun my-org-package-export (link description format &optional arg)
  (let* ((package-info (car (assoc-default (intern link) package-archive-contents)))
         (package-source (and package-info (package-desc-archive package-info)))
         (path (format
                (cond
                 ((null package-source) link)
                 ((string= package-source "gnu") "https://elpa.gnu.org/packages/%s.html")
                 ((string= package-source "melpa") "http://melpa.org/#/%s")
                 ((string= package-source "nongnu") "https://elpa.nongnu.org/nongnu/%s.html")
                 (t (error 'unknown-source)))
                link))
         (desc (or description link)))
    (if package-source
        (cond
         ((eq format '11ty) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
         ((eq format 'html) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
         ((eq format 'wp) (format "<a target=\"_blank\" href=\"%s\">%s</a>" path desc))
         ((eq format 'latex) (format "\\href{%s}{%s}" path desc))
         ((eq format 'texinfo) (format "@uref{%s,%s}" path desc))
         ((eq format 'ascii) (format "%s <%s>" desc path))
         (t path))
      desc)))

  (org-link-set-parameters "package" :follow 'my-org-package-open :export 'my-org-package-export)

  (ert-deftest my-org-package-export ()
    (should
     (string=
      (my-org-package-export "transcribe" "transcribe" 'html)
      "<a target=\"_blank\" href=\"https://elpa.gnu.org/packages/transcribe.html\">transcribe</a>"
      ))
    (should
     (string=
      (my-org-package-export "fireplace" "fireplace" 'html)
      "<a target=\"_blank\" href=\"https://melpa.org/#/fireplace\">fireplace</a>"
      )))

(defun my-announce-elpa-package (package-name)
  "Compose an announcement for PACKAGE-NAME for info-gnu-emacs."
  (interactive (let* ((guess (or (function-called-at-point)
                                 (symbol-at-point))))
                 (require 'finder-inf nil t)
                 ;; Load the package list if necessary (but don't activate them).
                 (unless package--initialized
                   (package-initialize t))
                 (let ((packages
                        (mapcar #'car
                                (seq-filter
                                 (lambda (p)
                                   (seq-find (lambda (entry)
                                               (string= (package-desc-archive entry)
                                                        "gnu"))
                                             (cdr p)))
                                 package-archive-contents))))
                   (unless (memq guess packages)
                     (setq guess nil))
                   (setq packages (mapcar #'symbol-name packages))
                   (let ((val
                          (completing-read (format-prompt "Describe package" guess)
                                           packages nil t nil nil (when guess
                                                                    (symbol-name guess)))))
                     (list (and (> (length val) 0) (intern val)))))))
  (let ((package (car (assoc-default package-name package-archive-contents))))
    (compose-mail "info-gnu-emacs@gnu.org"
                  (format "New GNU ELPA package: %s - %s"
                          (package-desc-name package)
                          (package-desc-summary package)))
    (message-goto-body)
    (describe-package-1 package-name)
    (message-goto-body)
    (delete-region (point)
                   (progn (re-search-forward " *Summary:") (match-beginning 0)))
    (save-excursion
      (goto-char (point-min))
      (when (re-search-forward "Maintainer: \\(.+\\)" nil t)
        (message-add-header (concat "Reply-To: " user-mail-address ", " (match-string 1))
                            (concat "Mail-Followup-To: " user-mail-address ", " (match-string 1)))))))

(defun my-emacs-news-escape-link-description (s)
  (let ((replace-map '(("\\[" . "")
                       ("\\]" . ":"))))
    (mapc (lambda (rule)
            (setq s (replace-regexp-in-string (car rule) (cdr rule) s)))
          replace-map)
    s))
(use-package xml-rpc)
(defun my-org-list-from-rss (url from-date &optional to-date)
  "Convert URL to an Org list. Return entries between FROM-DATE and TO-DATE.
FROM-DATE and TO-DATE should be strings of the form YYYY-MM-DD."
  (with-current-buffer (url-retrieve-synchronously url)
    (set-buffer-multibyte t)
    (goto-char (point-min))
    (re-search-forward "<\\?xml")
    (goto-char (match-beginning 0))
    (let* ((feed (xml-parse-region (point) (point-max)))
           (from-time (org-read-date nil t from-date))
           (to-time (if to-date (org-read-date nil t to-date)))
           (is-rss (> (length (xml-get-children (car feed) 'entry)) 0)))
      (mapconcat (lambda (link)
                   (format "- %s\n"
                           (org-link-make-string (car link) (cdr link))))
                 (if is-rss
                     (mapcar
                      (lambda (entry)
                        (cons
                         (xml-get-attribute (car
                                             (or
                                              (seq-filter (lambda (x) (string= (xml-get-attribute x 'rel) "alternate"))
                                                          (xml-get-children entry 'link))
                                              (xml-get-children entry 'link))) 'href)
                         (elt (car (xml-get-children entry 'title)) 2)))
                      (-filter (lambda (entry)
                                 (let ((entry-date (elt (car (xml-get-children entry 'updated)) 2)))
                                   (and
                                    (org-string<= from-date entry-date)
                                    (or (null to-date) (string< entry-date to-date)))))
                               (xml-get-children (car feed) 'entry)))
                   (mapcar (lambda (entry)
                             (cons
                              (caddr (car (xml-get-children entry 'link)))
                              (caddr (car (xml-get-children entry 'title)))))
                           (-filter (lambda (entry)
                                      (let ((entry-time (date-to-time (elt (car (xml-get-children entry 'pubDate)) 2))))
                                        (and
                                         (not (time-less-p entry-time from-time))
                                         (or (null to-time) (time-less-p entry-time to-time)))))
                                    (xml-get-children (car (xml-get-children (car feed) 'channel)) 'item))))
                 ""))))


  (defun my-insert-emacs-news-from-git (date &optional directory)
    (interactive (list (org-read-date)))
    (let ((result 
           (shell-command-to-string (format "cd ~/vendor/emacs; git pull > /dev/null; git log --pretty=oneline --after=%s etc/NEWS" (substring date 0 10)))))
      (with-temp-buffer
        (insert result)
        (goto-char (point-min))
        (while (re-search-forward "^\\([0-9a-f]+\\) \\(.+\\)$" nil t)
          (replace-match "  - [[https://git.savannah.gnu.org/cgit/emacs.git/commit/etc/NEWS?id=\\1][\\2]]"))
        (setq result (buffer-string)))
      (if (called-interactively-p 'any) (insert result) result)))
(defun my-insert-org-news-from-git (date &optional directory)
    (interactive (list (org-read-date)))
    (let ((result 
           (shell-command-to-string (format "cd ~/vendor/org-mode; git pull > /dev/null; git log --pretty=oneline --after=%s etc/ORG-NEWS" (substring date 0 10)))))
      (with-temp-buffer
        (insert result)
        (goto-char (point-min))
        (while (re-search-forward "^\\([0-9a-f]+\\) \\(.+\\)$" nil t)
          (replace-match "    - [[https://git.savannah.gnu.org/cgit/emacs/org-mode.git/commit/etc/ORG-NEWS?id=\\1][\\2]]"))
        (setq result (buffer-string)))
      (if (called-interactively-p 'any) (insert result) result)))

(defun my-emacs-news-commit-and-push (&optional title)
  (interactive)
  (when (magit-anything-unstaged-p)
    (my-magit-stage-all-and-commit (or title "update")))
  (unwind-protect (magit-push-current-to-pushremote (magit-push-arguments))))

(defun my-share-emacs-news ()
  "Prepare emacs-tangents e-mail of post, and commit to Git."
  (interactive)
  (require 'magit)
  (my-emacs-news-post-as-recent)
  (let ((html (org-export-as 'html))
        (text (org-export-as 'ascii nil nil t)))
    (with-temp-file "index.html"
      (insert html))
    (with-temp-file "index.txt"
      (insert text)))
  ;; Draft Gnus article
  (save-excursion
    (save-restriction
      (org-narrow-to-subtree)
      (let ((org-export-html-preamble nil)
            (org-html-toplevel-hlevel 3)
            (title (org-get-heading))
            output)
        (setq output
              (apply
               'format
               "<#multipart type=alternative>
<#part type=\"text/plain\" disposition=inline>
%s
<#/part>
<#part type=\"text/html\" disposition=inline>
%s
<#/part>
<#/multipart>
<#part type=\"text/x-org\" disposition=attachment name=\"emacs-news.org\">
%s
<#/part>
"
               (mapcar
                (lambda (format)
                  (org-export-string-as (buffer-substring (point-min) (point-max)) format t))
                '(ascii html org))))
        (kill-new output)
        (save-window-excursion
          (compose-mail "emacs-tangents@gnu.org" title)
          (message-goto-body)
          (insert output)
          (message-send-and-exit))
        (my-emacs-news-commit-and-push title)))))

(replace-regexp "    - \\[\\|[][()]" "")

(defvar my-emacs-calendar-csv "~/sync/emacs-calendar/events.csv")

(defun my-emacs-calendar-list ()
  (let ((before-limit (time-add (current-time) (seconds-to-time (* 14 24 60 60)))))
    (mapconcat 'cdr
               (sort
                (delq nil (mapcar
                           (lambda (o)
                             (let ((time (encode-time (parse-time-string (alist-get 'DTSTART o)))))
                               (and (time-less-p (current-time) time)
                                    (time-less-p time before-limit)
                                    (cons time (alist-get 'TEXT o)))))
                           (my-org-table-as-alist (pcsv-parse-file my-emacs-calendar-csv))))
                (lambda (a b) (time-less-p (car a) (car b))))
               "\n")))

(defun my-prepare-emacs-news (date parts)
  (interactive (list (org-read-date nil nil "-mon 0:00") '(refresh-packages reddit rss)))
  (setq date (substring date 0 10))
  (let* ((start-date date)
         (end-date (substring (org-read-date nil nil "++1" nil (org-read-date nil t "-sun 0:00")) 0 10))
         (year (substring end-date 0 4))
         (month (substring end-date 5 7)))
    (when (member 'refresh-packages parts)
      (package-refresh-contents)
      (my-update-package-list date)
      )
    (concat
     (format
      "** %s Emacs news
:PROPERTIES:
:EXPORT_ELEVENTY_PERMALINK: /blog/%s/%s/%s-emacs-news/
:EXPORT_ELEVENTY_FILE_NAME: blog/%s/%s/%s-emacs-news/
:EXPORT_DATE: %s
:END:\n\n"
      end-date
      year
      month
      end-date
      year
      month
      end-date
      (format-time-string "%Y-%m-%dT%T%z"))
     (if (member 'events parts)
         (concat
          "- Upcoming events:\n"
          (replace-regexp-in-string "^" "  " (my-emacs-calendar-list))
          "\n")
       "")
     (if (member 'git parts)
         (concat
          "- Emacs development:\n"
          (my-insert-emacs-news-from-git date)
          "\n"
          )
       "")
     (if (member 'git-org parts)
         (concat
          "- Org Mode:\n  - Org development:\n"
          (my-insert-org-news-from-git date)
          "\n"
          ))
     "- Other:\n"
     (if (member 'worg parts)
         (my-org-list-from-rss "https://tracker.orgmode.org/news.rss" (substring date 0 10))
       "")
     (if (member 'rss parts)
         (my-org-list-from-rss "https://planet.emacslife.com/atom.xml" (substring date 0 10))
       "")
     (if (member 'rss-es parts)
         (my-org-list-from-rss "https://planet.emacs-es.org/atom.xml" (substring date 0 10))
       "")
     "\n"
     (if (member 'reddit parts) (my-reddit-list-upvoted (substring date 0 10)) "")
     (if (member 'youtube parts)
         (my-emacs-news-youtube-playlist my-emacs-news-playlist start-date))
     (if (member 'librehacker parts)
         (my-emacs-news-parse-gem-librehacker-com date)
       "")
     "- New packages:\n"
     (my-list-new-packages date)
     "\n\nLinks from "
     (mapconcat (lambda (x) (org-link-make-string (car x) (cdr x)))
                '(("https://www.reddit.com/r/emacs" . "reddit.com/r/emacs")
                  ("https://www.reddit.com/r/orgmode" . "r/orgmode")
                  ("https://www.reddit.com/r/spacemacs" . "r/spacemacs")
                  ("https://www.reddit.com/r/planetemacs" . "r/planetemacs")
                  ("https://mastodon.social/tags/emacs" . "Mastodon #emacs")
                  ("https://hn.algolia.com/?query=emacs&sort=byDate&prefix&page=0&dateRange=all&type=story" . "Hacker News")
                  ("https://lobste.rs/search?q=emacs&what=stories&order=newest" . "lobste.rs")
                  ("https://kbin.social/m/emacs/newest" . "kbin")
                  ("https://programming.dev/c/emacs?dataType=Post&page=1&sort=New" . "programming.dev")
                  ("https://lemmy.world/c/emacs" . "lemmy.world")
                  ("https://lemmy.ml/c/emacs?dataType=Post&page=1&sort=New" . "lemmy.ml")
                  ("https://communick.news/c/emacs?dataType=Post&page=1&sort=New" . "communick.news")
                  ("https://planet.emacslife.com" . "planet.emacslife.com")
                  ("https://www.youtube.com/playlist?list=PL4th0AZixyREOtvxDpdxC9oMuX7Ar7Sdt" . "YouTube")
                  ("http://git.savannah.gnu.org/cgit/emacs.git/log/etc/NEWS" . "the Emacs NEWS file")
                  ("https://emacslife.com/calendar/" . "Emacs Calendar"))
                ", ")
     ", and "
     (org-link-make-string (concat "http://lists.gnu.org/archive/html/emacs-devel/" (format-time-string "%Y-%m"))
                           "emacs-devel")
     ". Thanks to Andrés Ramírez for emacs-devel links. Do you have an Emacs-related link or announcement? Please e-mail me at [[mailto:sacha@sachachua.com][sacha@sachachua.com]]. Thank you!")))

  (defun my-emacs-news-collect-entries ()
    "Collect Emacs News by category and put them in another buffer."
    (interactive)
    (let ((parsed (org-element-parse-buffer))
          category
          result)
      (setq result
            (mapconcat
             (lambda (x)
               (concat "* " (car x) "\n\n"
                       (mapconcat (lambda (y) (concat "- " (cdr y))) (cdr x) "")
                       "\n"))
             (sort (seq-group-by
                    'car
                    (delq nil
                          (org-element-map parsed '(paragraph)
                            (lambda (x)
                              (let ((contents (org-element-interpret-data x)))
                                (cond
                                 ((string-match "^\\(.*\\):[ \t\n]*$" contents)
                                  (setq category (match-string-no-properties 1 contents))
                                  nil)
                                 ((string-match "^\\[" contents)
                                  (cons category (substring-no-properties contents)))))))))
                   (lambda (a b) (string< (car a) (car b))))
             ""))
      (switch-to-buffer (get-buffer-create "*Emacs News*"))
      (erase-buffer)
      (insert result)
      (org-mode)
      (goto-char (point-min))))

(defvar my-emacs-news-check-duplicates-display 'overlay "*minibuffer or posframe or overlay")
(defvar my-emacs-news-duplicate-overlay nil)
(defun my-emacs-news-check-duplicates ()
  (interactive)
  (let ((end (save-excursion (org-end-of-subtree)))
        (prompt-buffer (when (eq my-emacs-news-check-duplicates-display 'posframe) (get-buffer-create "*Duplicate*")))
        description
        (search-fn (lambda (point search description)
                     (save-excursion
                       (goto-char point)
                       (let (found)
                         (if (re-search-forward (regexp-quote search) nil t)
                             (setq found (point))
                           ;; Does this look like a package name?
                           (let ((case-fold-search nil))
                             (when (string-match "^\\([-\\.a-z0-9]+?\\)\\(:\\|\\.el\\) " description)
                               (when (re-search-forward (concat "\\W" (regexp-quote (match-string 1 description))) nil t)
                                 (setq found (point))))))
                         found))))
        search start
        found
        done
        context)
    (unwind-protect
        (while (and (not done) (re-search-forward "- \\[\\[\\([^[]+\\)\\]\\[\\([^[]+\\)\\]" end t))
          (setq found nil search (match-string 1) start (match-beginning 0) description (match-string 2))
          (goto-char (match-end 0))
          (let ((p (point)) prompt input)
            ;; Search for the URL
            (setq found (funcall search-fn (match-end 0) search description))
            (while found
              (goto-char found)
              (setq context
                    (concat
                     (string-join (org-get-outline-path t) " > ") "\n"
                     (buffer-substring (line-beginning-position) (line-end-position))))
              (push-mark found)
              (goto-char start)
              (setq prompt (concat context "\n(d)elete, (k)eep, (z)ap next one, e(x)change mark, (n)ext match, (q)quit?"))
              (pcase my-emacs-news-check-duplicates-display
                ('posframe
                 ;; (when (eq my-emacs-news-check-duplicates-display 'posframe) (posframe-hide prompt-buffer))
                 (posframe-show prompt-buffer
                                :string prompt
                                :internal-border-width 2
                                :internal-border-color "white"
                                :position (point))
                 (setq input (read-char)))
                ('minibuffer
                 (setq input (read-char prompt)))
                ('overlay
                 (if (overlayp my-emacs-news-duplicate-overlay)
                     (move-overlay my-emacs-news-duplicate-overlay (line-beginning-position) (line-end-position))
                   (setq my-emacs-news-duplicate-overlay (make-overlay (line-beginning-position) (line-end-position))))
                 (overlay-put my-emacs-news-duplicate-overlay 'after-string
                              (propertize
                               (concat "\n" prompt)
                               'face '(:box t)))
                 (recenter-top-bottom)
                 (setq input (read-char))))
              (pcase input
                (?k
                 (forward-line 1)
                 (setq found nil))
                (?x
                 (goto-char found)
                 (setq done t found nil))
                (?z
                 (goto-char found)
                 (delete-region (point-at-bol)
                                (progn (forward-line 1) (point)))
                 (goto-char start)
                 (setq found nil))
                (?d
                 (delete-region (point-at-bol)
                                (progn (forward-line 1) (point)))
                 (setq found nil))
                (?n
                 ;; Look for the next match
                 (setq found (funcall search-fn (save-excursion (goto-char found) (line-end-position))
                                      search description)))
                (?q
                 (setq done t found nil))))))
      (pcase my-emacs-news-check-duplicates-display
        ('posframe (posframe-delete prompt-buffer))
        ('overlay (delete-overlay my-emacs-news-duplicate-overlay))))))

(defvar my-org-categorize-emacs-news-menu
  '(("0" . "Other")
    ("1" . "Emacs Lisp")
    ("2" . "Emacs development")
    ("3" . "Emacs configuration")
    ("4" . "Appearance")
    ("5" . "Navigation")
    ("6" . "Org Mode")
    ("7" . "Coding")
    ("8" . "Community")
    ("9" . "Spacemacs")))

(defun my-org-get-list-categories ()
  "Return a list of (category indent matching-regexp sample).
List categories are items that don't contain links."
  (let ((list (org-list-struct)) last-category results)
    (save-excursion
      (mapc
       (lambda (x)
         (goto-char (car x))
         (let ((current-item
                (buffer-substring-no-properties
                 (+ (point)
                    (elt x 1)
                    (length (elt x 2)))
                 (line-end-position))))
           (if (string-match
                org-any-link-re
                (buffer-substring-no-properties
                 (point)
                 (line-end-position)))
               ;; Link - update the last category
               (when last-category
                 (if (< (elt x 1) (elt last-category 1))
                     (setq results
                           (cons (append last-category
                                         (list
                                          (match-string-no-properties
                                           3
                                           (buffer-substring-no-properties
                                            (point)
                                            (line-end-position)))))
                                 (cdr results))))
                 (setq last-category nil))
             ;; Category
             (setq results
                   (cons
                    (setq last-category
                          (list
                           current-item
                           (elt x 1)
                           (concat "^"
                                   (make-string (elt x 1) ?\ )
                                   (regexp-quote
                                    (concat (elt x 2)
                                            current-item))
                                   "$")))
                    results)))))
       list))
    (append '(("x" 2 "^$" nil)) results)))

(defun my-org-move-current-item-to-category (category)
  "Move current list item under CATEGORY earlier in the list.
  CATEGORY can be a string or a list of the form (text indent regexp).
  Point should be on the next line to process, even if a new category
  has been inserted."
  (interactive (list (completing-read "Category: " (my-org-get-list-categories))))
  (when category
    (let* ((beg (line-beginning-position))
           (end (line-end-position))
           (string (org-trim (buffer-substring-no-properties beg end)))
           (category-text (if (stringp category) category (elt category 0)))
           (category-indent (if (stringp category) 2 (+ 2 (elt category 1))))
           (category-regexp (if (stringp category) category (elt category 2)))
           (pos (point))
           s)
      (delete-region beg (min (1+ end) (point-max)))
      (unless (string= category-text "x")
        (if (re-search-backward category-regexp nil t)
            (forward-line 1)
          (setq s (concat "- " category-text "\n"))
          (insert s)
          (setq pos (+ (length s) pos)))
        (insert (make-string category-indent ?\ )
                string "\n")
        (goto-char (+ pos (length string) category-indent 1))
        (recenter)))))

(eval
 `(defhydra my-org-categorize-emacs-news (:foreign-keys nil)
    "
Default: %(my-emacs-news-guess-category)"
    ,@(mapcar
       (lambda (x)
         `(,(car x)
           (lambda () (interactive) (my-org-move-current-item-to-category ,(concat (cdr x) ":")))
           ,(cdr x)))
       my-org-categorize-emacs-news-menu)
    ("RET"
     (my-org-move-current-item-to-category (concat (my-emacs-news-guess-category) ":")))
    (","
     (lambda () (interactive)
       (my-org-move-current-item-to-category
        (completing-read
         "Category: "
         (append (mapcar (lambda (o) (concat o ":")) (my-emacs-news-sort-order-headings))
                 (mapcar 'car (my-org-get-list-categories))))))
     "By string")
("l" my-spookfox-open-link-from-page "Open link")
("L" my-spookfox-insert-link-from-page "Insert link")
("u" my-spookfox-insert-link-to-tab "Insert tab")
    ("/" (lambda () (interactive)
           (save-excursion
             (re-search-forward "\\[\\[")
             (let ((browse-url-browser-function 'my-spookfox-background-tab))
               (org-open-at-point))))
     "Open bg")
    ("?" (lambda () (interactive)
           (save-excursion
             (re-search-forward "\\[\\[")
             (org-open-at-point)))
     "Open fg")
    ("*"
     (lambda () (interactive)
       (if (string= (buffer-name) "*Messages*")
           (bury-buffer)
         (save-excursion
           (re-search-forward org-link-bracket-re)
           (message (match-string 1)))
         (switch-to-buffer "*Messages*")))
     "Show URL")
    ("-" kill-whole-line "Kill")
    ("c"
     (save-excursion
       (re-search-forward "\\[\\[")
       (elfeed-tube-fetch (org-element-property :raw-link (org-element-context)))
       ;; (my-caption-show (org-element-property :raw-link (org-element-context)))
       )
     "Caption")
    ("p" org-next-link "Previous link")
    ("n" org-next-link "Next link")
    ("v" my-spookfox-scroll-down "Scroll FF down")
    ("V" my-spookfox-scroll-up "Scroll FF up")
    ("C-M-v" scroll-other-window :hint nil)
    ("C-M-S-v" scroll-other-window-down :hint nil)
    ("h" (lambda () (interactive) (my-org-update-link-description "HN")) "Link HN")
    ("i" (lambda () (interactive) (my-org-update-link-description "Irreal")) "Link Irreal")
    ("." nil "Done")))

(defun my-emacs-news-post-as-recent ()
  (interactive)
  (let ((formats '((ascii . "txt")
                   (html . "html")
                   (org . "org"))))
    (dolist (format formats)
      (let ((data (org-export-as (car format) t nil (eq (car format) 'ascii))))
        (with-temp-file (concat "most-recent." (cdr format))
          (insert data))))))

(defvar my-t-executable "t" "Twitter command-line tool")
(defun my-tweet-emacs-news ()
  (interactive)
  (let ((text (concat (org-get-heading t t t t)
                    " https://sachachua.com"
                    (org-entry-get (point) "EXPORT_ELEVENTY_PERMALINK"))))
    (my-mastodon-toot-public-string text)
    (kill-new text)
    (browse-url "https://www.twitter.com")))

(defun my-emacs-news-spookfox-insert-current-link ()
  (interactive)
  (let ((info (spookfox-js-injection-eval-in-active-tab
               "[window.location.href, document.querySelector('title').textContent]" t)))
    (insert "- " (org-link-make-string (aref info 0) (aref info 1)) "\n")))

(defun my-emacs-news-parse-gem-librehacker-com (date)
  (with-current-buffer (url-retrieve-synchronously "http://gem.librehacker.com/gemlog/starlog/")
    (goto-char (point-min))
    (re-search-forward "^$")
    (let* ((dom (libxml-parse-html-region (point) (point-max)))
           (links (dom-by-tag dom 'a)))
      (mapconcat (lambda (o)
                   (or
                    (when (dom-attr o 'href)
                      (when (and (string-match "emacs" (dom-text o))
                                 (string-match "^[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]" (dom-text o))
                                 (not (string< (match-string 0 (dom-text o)) date)))
                        (concat "- " (org-link-make-string
                                      (concat "http://gem.librehacker.com" (dom-attr o 'href))
                                      (dom-text o))
                                "\n")))
                    ""))
                 links ""))))

(defun my-insert-string (s)
  (interactive "MString: ")
  (insert s))

0-9	Select options from the list, with 0 for other.
\/	Opens the URL in a web browser
,	Selects a category by name, creating as needed
\*	Shows the URL in the messages buffer, and toggles it
-	Deletes the item
.	Quits

STARTED Do another Emacs News review

2024-10-07 Emacs news

2024-09-30 Emacs news

2024-09-23 Emacs news

2024-09-16 Emacs news

2024-09-09 Emacs news

2024-09-02 Emacs news

2024-08-26 Emacs news

2024-08-19 Emacs news

2024-08-12 Emacs news

2024-08-05 Emacs news

DONE 2024-07-29 Emacs news

2024-07-22 Emacs news

2024-07-15 Emacs news

2024-07-08 Emacs news

2024-07-01 Emacs news

2024-06-24 Emacs news

2024-06-17 Emacs news

2024-06-10 Emacs news

2024-06-03 Emacs news

2024-05-27 Emacs news

2024-05-20 Emacs news

2024-05-13 Emacs news

2024-05-06 Emacs news

2024-04-29 Emacs news

2024-04-22 Emacs news

2024-04-15 Emacs news

2024-04-08 Emacs news

2024-04-01 Emacs news

2024-03-25 Emacs news

2024-03-18 Emacs news

2024-03-11 Emacs news

2024-03-04 Emacs news

2024-02-26 Emacs news

2024-02-19 Emacs news

2024-02-12 Emacs news

2024-02-05 Emacs news

2024-01-29 Emacs news

2024-01-22 Emacs news

2024-01-15 Emacs news

2024-01-08 Emacs news

2024-01-01 Emacs news

2023-12-25 Emacs news

2023-12-18 Emacs news

2023-12-11 Emacs news

2023-12-04 Emacs news

2023-11-27 Emacs news

2023-11-20 Emacs news

2023-11-13 Emacs news

2023-11-06 Emacs news

2023-10-30 Emacs news

2023-10-23 Emacs news

2023-10-16 Emacs news

2023-10-09 Emacs news

2023-10-02 Emacs news

2023-09-25 Emacs news

2023-09-18 Emacs news

2023-09-11 Emacs news

2023-09-04 Emacs news

2023-08-28 Emacs news

2023-08-21 Emacs news

2023-08-14 Emacs news

2023-08-07 Emacs news

2023-07-31 Emacs news

2023-07-24 Emacs news

2023-07-17 Emacs news

2023-07-10 Emacs news

2023-07-03 Emacs news

2023-06-26 Emacs news

2023-06-19 Emacs news

2023-06-12 Emacs news

2023-06-05 Emacs news

2023-05-29 Emacs news

2023-05-22 Emacs news

2023-05-15 Emacs news

2023-05-08 Emacs news

2023-05-01 Emacs news

2023-04-24 Emacs news

2023-04-17 Emacs news

2023-04-10 Emacs news